home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / ffccflow / ffccflow.lha / ffccc+flow / ffccc / USSBEG.f < prev    next >
Encoding:
Text File  |  1992-07-31  |  21.4 KB  |  562 lines
  1.       SUBROUTINE USSBEG 
  2. *-----------------------------------------------------------------------
  3. *   
  4. *--- user start of filtered statement (treat names here)
  5. *   
  6. *-----------------------------------------------------------------------
  7.       include 'PARAM.h' 
  8.       include 'ALCAZA.h' 
  9.       include 'CLASS.h' 
  10.       include 'CURSTA.h' 
  11.       include 'FLWORK.h' 
  12.       include 'KEYCOM.h' 
  13.       include 'TYPDEF.h' 
  14.       include 'JOBSUM.h' 
  15.       include 'STATE.h' 
  16.       include 'FLAGS.h' 
  17.       include 'USCOMN.h' 
  18.       include 'USSTMT.h' 
  19.       include 'USIGNO.h' 
  20.       include 'USLIST.h' 
  21.       include 'USUNIT.h' 
  22.       include 'USARGS.h' 
  23.       include 'USINFN.h' 
  24.       include 'USLTYD.h' 
  25.       include 'CHECKS.h' 
  26.       CHARACTER*(MXNMCH) CNAM   
  27.       CHARACTER*25 C25NAM   
  28.       LOGICAL FOK   
  29.       DATA ICALL /0/
  30.       IF(UNFLP) RETURN  
  31.       IF(ICALL.EQ.0) THEN   
  32.          ISGLOB = 0 
  33.          ICALL = 1  
  34.       ENDIF 
  35. C Determine whether this module is to be processed  
  36.       IF(.NOT.RPROCS) RETURN
  37.       NST = NFLINE(NSTREF)  
  38.       NFI = NLLINE(NSTREF)  
  39.       ICL1 = ICURCL(1)  
  40.       ICL2 = ICURCL(2)  
  41. C ICL1 is class of first part of statement  
  42. C ICL2 is class of second part if ICL1 is an IF statement   
  43.       IF(LMODUS(ICL1)) THEN 
  44. C Module start  
  45. C   
  46.          IF(NIGNOS.NE.0) THEN   
  47.             CNAM = SNAMES(ISNAME+1) 
  48.             ILEN = INDEX(CNAM,' ')-1
  49.             IF(ILEN.EQ.-1) ILEN = MXNMCH
  50.             DO 10 IGN=1,NIGNOS  
  51.                IF(LIGNOS(IGN).NE.ILEN)                           GOTO 10
  52.                IF(CIGNOS(IGN).EQ.CNAM) THEN 
  53.                   NFAULT = 0
  54.                   RPROCS = .FALSE.  
  55.                   RETURN
  56.                ENDIF
  57.    10       CONTINUE
  58.          ENDIF  
  59.          WRITE(MZUNIT,550) (SIMA(II)(7:),II=NST,NFI)
  60.          ISTMT = 0  
  61.          NCOMN = 0  
  62.          NCOMT = 0  
  63.          IFUNC = 0  
  64. C Set FUNCTION flag 
  65.          IF(LFUNCT(ICL1)) IFUNC = 1 
  66.          ICLOLD = ICL1  
  67.          NFIOLD = NFI   
  68.          IF(LCHECK(11).AND.NSTREF.NE.1) WRITE(MZUNIT,560)   
  69. C Make check for module names the same as intrinsic functions   
  70.          CNAM = SNAMES(ISNAME+1)
  71.          ILEN = INDEX(CNAM,' ')-1   
  72.          IF(LCHECK(12)) THEN
  73.             DO 20 I=1,LIF   
  74.                IF(ILEN.NE.INDEX(CINFUN(I),' ')-1)                GOTO 20
  75.                IF(CNAM(:ILEN).NE.CINFUN(I)(:ILEN))               GOTO 20
  76.                WRITE(MZUNIT,570) CNAM,CNAM  
  77.                NFAULT = NFAULT + 1  
  78.                                                                  GOTO 30
  79.    20       CONTINUE
  80.    30       CONTINUE
  81.          ENDIF  
  82. C First statement in input should be module declaration 
  83.       ELSE IF(LCHECK(13).AND.ISGLOB.EQ.0.AND.NFIOLD.EQ.0) THEN  
  84.          WRITE(MZUNIT,500)  
  85.          NFAULT = NFAULT + 1
  86.       ENDIF 
  87. C Make check for comment lines after start of routine   
  88.       ISTMT=ISTMT+1 
  89.       IF(LCHECK(14).AND.ISTMT.EQ.2) THEN
  90.          IF(NST-NFIOLD.LT.3) THEN   
  91.             WRITE(MZUNIT,580)   
  92.             NFAULT = NFAULT + 1 
  93.          ENDIF  
  94.       ENDIF 
  95.       IF(NST-NFIOLD.GT.1) THEN  
  96.          IF(USFULL) WRITE(MZUNIT,510) (II+ISGLOB,SIMA(II), II=NFIOLD+1, 
  97.      +   NST-1) 
  98. C Check comment lines   
  99.          ICMSET = 0 
  100.          DO 40 I=NFIOLD+1,NST-1 
  101.             IF(NLTYPE(I).EQ.0) THEN 
  102. C Store comment line if TREE option requested   
  103.                IF(ACTION(29).AND.SIMA(I)(1:2).EQ.'C!') THEN 
  104.                   IF(ICMSET.EQ.0) CMMNT = SIMA(I)(3:LARC+2) 
  105.                   ICMSET = 1
  106.                ENDIF
  107. C comment lines should start with C 
  108.                IF(LCHECK(15).AND.SIMA(I)(1:1).NE.'C') THEN  
  109.                   IF(.NOT.USFULL) WRITE(MZUNIT,510) I+ISGLOB,SIMA(I)
  110.                   WRITE(MZUNIT,590) 
  111.                   NFAULT = NFAULT + 1   
  112.                ENDIF
  113.             ENDIF   
  114.    40    CONTINUE   
  115.       ENDIF 
  116.       NFIOLD = NFI  
  117. C Write all statements to MZUNIT if USFULL set  
  118.       IF(USFULL) THEN   
  119.         WRITE(MZUNIT,510) (II+ISGLOB,SIMA(II),II=NST,NFI)   
  120.       ENDIF 
  121. C   
  122. C Check for comment lines in between continuations  
  123.       IF(LCHECK(16).AND.NFI-NST.GT.0) THEN  
  124.          DO 50 IST=NST+1,NFI-1  
  125.             IF(SIMA(IST)(:5).NE.'      ') THEN  
  126.                IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB,SIMA(II),II 
  127.      +         =NST,NFI)
  128.                WRITE(MZUNIT,610)
  129.                NFAULT = NFAULT + 1  
  130.                                                                  GOTO 60
  131.             ENDIF   
  132.    50    CONTINUE   
  133.    60    CONTINUE   
  134.       ENDIF 
  135. C Check for standard variable types 
  136.       IF(LCHECK(17).AND.LNSVT(ICL1)) THEN   
  137.          IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB,SIMA(II),II=NST,  
  138.      +   NFI)   
  139.          WRITE(MZUNIT,520)  
  140.          NFAULT = NFAULT + 1
  141.       ENDIF 
  142. C Collect list of COMMON names used in this routine 
  143.       IF(LCOMMN(ICL1)) THEN 
  144. C First check that only one COMMON name per COMMON statement
  145.          IPOS1 = INDEX(SSTA(:NCHST),'/')
  146.          IF(IPOS1.EQ.0) GOTO 70 
  147.          IPOS2 = INDEX(SSTA(IPOS1+1:NCHST),'/') 
  148.          IF(IPOS2.EQ.0) GOTO 70 
  149.          IPOS3 = INDEX(SSTA(IPOS1+IPOS2+1:NCHST),'/')   
  150.          IF(IPOS3.NE.0) THEN
  151.             IF(.NOT.USFULL) WRITE(MZUNIT,850)   
  152.      &                   (II+ISGLOB,SIMA(II),II =NST,NFI)   
  153.             WRITE(MZUNIT,620)   
  154.             NFAULT = NFAULT + 1 
  155.          ENDIF  
  156.    70    CONTINUE   
  157.          NCOMT = NCOMT + 1  
  158.          IF(NCOMT.GT.MCOMT) THEN
  159.             NCOMT = NCOMT-1 
  160.             WRITE(MZUNIT,630)   
  161.                                                                 GOTO 110
  162.          ENDIF  
  163. C Take account of blank COMMON  
  164.          IF(INDEX(SSTA(:NCHST),'//').NE.0.OR.   
  165.      &      INDEX(SSTA(:NCHST),'/ /').NE.0) THEN
  166.             SCTITL(NCOMT) = 'BLANKCOM'  
  167.             IST = 1 
  168.          ELSE   
  169.             SCTITL(NCOMT) = SNAMES(ISNAME+1)
  170.             IST = 2 
  171.          ENDIF  
  172.          ICTITL(NCOMT) = NCOMN + 1  
  173.          DO 100 ISN=IST,NSNAME  
  174. C We ensure that the list of names for this COMMON block does not   
  175. C include parameters. This is done by checking for no hanging parentheses.  
  176.             IBEG = NSSTRT(ISN)  
  177.             ICOUNB = 0  
  178.             DO 95 ICH=1,IBEG-1  
  179.                IF(SSTA(ICH:ICH).EQ.'(') THEN
  180.                  ICOUNB=ICOUNB+1
  181.                ELSE IF(SSTA(ICH:ICH).EQ.')') THEN   
  182.                  ICOUNB=ICOUNB-1
  183.                ENDIF
  184.    95       CONTINUE
  185.             IF(ICOUNB.NE.0) GOTO 100
  186.             NCOMN = NCOMN + 1   
  187.             IF(NCOMN.GT.MCOMN) THEN 
  188.                NCOMN = NCOMN-1  
  189.                WRITE(MZUNIT,640)
  190.                                                                 GOTO 110
  191.             ENDIF   
  192.             SCNAME(NCOMN) = SNAMES(ISNAME+ISN)  
  193.             ICNAME(NCOMN) = NCOMT   
  194.   100    CONTINUE   
  195.   110    CONTINUE   
  196.       ENDIF 
  197. C Check for statements which dimension outside COMMON   
  198.       IF(LCHECK(19).AND.LDIMEN(ICL1)) THEN  
  199.          IOVER = 0  
  200.          DO 150 I=1,NSNAME  
  201.             CNAM = SNAMES(I+ISNAME) 
  202.             ILEN = INDEX(CNAM,' ')-1
  203.             IF(ILEN.EQ.-1)                                      GOTO 150
  204.             MATCH = 0   
  205.             DO 130 IC=1,NCOMN   
  206.                ILEN1 = INDEX(SCNAME(IC),' ')-1  
  207.                IF(ILEN1.NE.ILEN)                                GOTO 130
  208.                IF(CNAM.NE.SCNAME(IC))                           GOTO 130
  209.                MATCH = 1
  210. C Now have found a declaration of a name in COMMON  
  211. C Search for position of name in the statement  
  212.                INDE = NSEND(I)+1
  213. C Search for ( or , and ignore blanks   
  214.                DO 120 IPL = INDE,NCHST  
  215.                   IF(SSTA(IPL:IPL).EQ.' ')                      GOTO 120
  216.                   IF(SSTA(IPL:IPL).EQ.',')                      GOTO 140
  217.                   IF(SSTA(IPL:IPL).EQ.'(') THEN 
  218. C array declaration 
  219.                      IF(IOVER.EQ.0.AND..NOT.USFULL) WRITE(MZUNIT,850)   
  220.      +               (II+ ISGLOB, SIMA(II),II=NST,NFI)  
  221.                      WRITE(MZUNIT,650) CNAM 
  222.                      NFAULT = NFAULT + 1
  223.                      IOVER = 1  
  224.                                                                 GOTO 150
  225.                   ELSE  
  226.                                                                 GOTO 140
  227.                   ENDIF 
  228.   120          CONTINUE 
  229.   130       CONTINUE
  230.   140       CONTINUE
  231.   150    CONTINUE   
  232.       ENDIF 
  233. C Check for embedded blanks in names
  234.       IF(LCHECK(20)) THEN   
  235.          IDONE = 0  
  236.          DO 160 I=1,NSNAME  
  237.             CNAM=SNAMES(I+ISNAME)   
  238.             ILEN1 = INDEX(CNAM,' ')-1   
  239.             IF(ILEN1.EQ.-1) ILEN1 = MXNMCH  
  240.             IF(ILEN1.GT.6)                                      GOTO 160
  241.             NS = NSSTRT(I)  
  242.             NE = NSEND(I)   
  243.             ILEN2 = NE-NS+1 
  244.             IF(ILEN2.NE.ILEN1) THEN 
  245.                IF(IDONE.EQ.0.AND..NOT.USFULL) WRITE(MZUNIT,850) (II 
  246.      +         +ISGLOB, SIMA(II),II=NST, NFI)   
  247.                WRITE(MZUNIT,660) CNAM   
  248.                IDONE = 1
  249.                NFAULT = NFAULT + 1  
  250.             ENDIF   
  251.   160    CONTINUE   
  252.       ENDIF 
  253. C Now check for embedded blanks in  syntactic entities  
  254.       NF1 = ISTMDS(3,ICL1)  
  255.       NL1 = ISTMDS(4,ICL1)  
  256.       IF(LIFF(ICL1)) THEN   
  257.          NF2 = ISTMDS(3,ICL2)   
  258.          NL2 = ISTMDS(4,ICL2)   
  259.       ELSE  
  260.          NF2 = 0
  261.       ENDIF 
  262.       IF(LCHECK(21)) THEN   
  263. C DEFSTA returns FOK=.TRUE. if statement ICL1 is to be checked  
  264.          CALL DEFSTA(ICL1,ILEN,C25NAM,FOK)  
  265.          IF(FOK) THEN   
  266.             INDE = INDEX(SIMA(NST),C25NAM(:ILEN))   
  267.             IF(INDE.EQ.0) THEN  
  268.                IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB,SIMA(II),II 
  269.      +         =NST, NFI)   
  270.                WRITE(MZUNIT,670) C25NAM 
  271.                NFAULT = NFAULT + 1  
  272.             ELSE
  273.                IF(SIMA(NST)(INDE+ILEN:INDE+ILEN).NE.' ') THEN   
  274.                   IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB,SIMA(II),
  275.      +            II =NST,NFI)  
  276.                   WRITE(MZUNIT,680) C25NAM  
  277.                   NFAULT = NFAULT + 1   
  278.                ENDIF
  279.             ENDIF   
  280.          ENDIF  
  281. C Special treatment of GO TO and ELSE IF
  282.          IF(LELSE(ICL1)) THEN   
  283.             INDE = INDEX(SSTA(:NCHST),'ELSE')   
  284.             IF(INDE.EQ.0) THEN  
  285.                IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB,SIMA(II), II
  286.      +         =NST,NFI)
  287.                WRITE(MZUNIT,690)
  288.                NFAULT = NFAULT + 1  
  289.             ELSE
  290.                IBL = 0  
  291.                DO 170 ICH=INDE+4,NCHST  
  292.                   IF(SSTA(ICH:ICH).EQ.' ') THEN 
  293.                      IBL=IBL+1  
  294.                                                                 GOTO 170
  295.                   ELSE IF(SSTA(ICH:ICH+1).EQ.'IF') THEN 
  296.                      IF(IBL.GT.1) THEN  
  297.                         IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB,   
  298.      +                  SIMA(II), II=NST,NFI)   
  299.                         WRITE(MZUNIT,690)   
  300.                                                                 GOTO 180
  301. C             ELSE IF(SSTA(ICH+2:ICH+2).NE.' ') THEN
  302. C               IF(.NOT.USFULL) WRITE(MZUNIT,685) (II+ISGLOB,SIMA(II),  
  303. C    &          II=NST,NFI) 
  304. C               WRITE(MZUNIT,610)   
  305. C               GOTO 334
  306.                      ENDIF  
  307.                   ENDIF 
  308.                                                                 GOTO 180
  309.   170          CONTINUE 
  310.   180          CONTINUE 
  311.             ENDIF   
  312.          ENDIF  
  313.          IF(LGOTO(ICL1)) THEN   
  314.             INDE = 0
  315.             INDE1 = INDEX(SSTA(:NCHST),'GO TO') 
  316.             IF(INDE1.EQ.0) INDE = INDEX(SSTA(:NCHST),'GOTO')
  317.             IF(INDE.EQ.0.AND.INDE1.EQ.0) THEN   
  318.                IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB,SIMA(II),II 
  319.      +         =NST, NFI)   
  320.                WRITE(MZUNIT,710)
  321.                NFAULT = NFAULT + 1  
  322.             ELSE IF(INDE1.NE.0.AND.INDEX(SSTA(:NCHST),'GO TO ').EQ.0)   
  323.      +         THEN 
  324.                IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB,SIMA(II),II 
  325.      +         =NST, NFI)   
  326.                WRITE(MZUNIT,720)
  327.                NFAULT = NFAULT + 1  
  328.             ELSE IF(INDE.NE.0.AND.INDEX(SSTA(:NCHST),'GOTO ').EQ.0) 
  329.      +         THEN 
  330.                IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB,SIMA(II),II 
  331.      +         =NST, NFI)   
  332.                WRITE(MZUNIT,730)
  333.                NFAULT = NFAULT + 1  
  334.             ENDIF   
  335.          ENDIF  
  336. C End special treatment for ICL1
  337.          IF(NF2.NE.0) THEN  
  338.             CALL DEFSTA(ICL2,ILEN,C25NAM,FOK)   
  339.             IF(FOK) THEN
  340.                DO 190 IJ=NST,NFI
  341.                   INDE = INDEX(SIMA(IJ),C25NAM(:ILEN))  
  342.                   IF(INDE.NE.0) THEN
  343.                      IF(SIMA(IJ)(INDE+ILEN:INDE+ILEN).NE.' ') THEN  
  344.                         IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB,   
  345.      +                  SIMA(II),II =NST,NFI)   
  346.                         WRITE(MZUNIT,680) C25NAM
  347.                         NFAULT = NFAULT + 1 
  348.                      ENDIF  
  349.                                                                 GOTO 200
  350.                   ENDIF 
  351.   190          CONTINUE 
  352.                IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB,SIMA(II),II 
  353.      +         =NST, NFI)   
  354.                WRITE(MZUNIT,670) C25NAM 
  355.                NFAULT = NFAULT + 1  
  356.   200          CONTINUE 
  357.             ENDIF   
  358.          ENDIF  
  359. C Special treatment of GO TO after IF statement 
  360.          IF(LGOTO(ICL2).AND.NF2.NE.0) THEN  
  361.             DO 210 IJ=NST,NFI   
  362.                INDE = 0 
  363.                INDE1 = INDEX(SIMA(IJ),'GO TO')  
  364.                IF(INDE1.EQ.0) INDE = INDEX(SIMA(IJ),'GOTO') 
  365.                IF(INDE.NE.0) THEN   
  366.                   IF(INDEX(SIMA(IJ),'GOTO ').EQ.0) THEN 
  367.                      IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB,SIMA  
  368.      +               (II),II =NST,NFI)  
  369.                      WRITE(MZUNIT,740)  
  370.                      NFAULT = NFAULT + 1
  371.                   ENDIF 
  372.                                                                 GOTO 220
  373.                ELSE IF(INDE1.NE.0) THEN 
  374.                   IF(INDEX(SIMA(IJ),'GO TO ').EQ.0) THEN
  375.                      IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB,SIMA  
  376.      +               (II),II =NST,NFI)  
  377.                      WRITE(MZUNIT,750)  
  378.                      NFAULT = NFAULT + 1
  379.                   ENDIF 
  380.                                                                 GOTO 220
  381.                ELSE IF(IJ.EQ.NFI) THEN  
  382.                   IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB,SIMA(II),
  383.      +            II =NST,NFI)  
  384.                   WRITE(MZUNIT,760) 
  385.                   NFAULT = NFAULT + 1   
  386.                                                                 GOTO 220
  387.                ENDIF
  388.   210       CONTINUE
  389.   220       CONTINUE
  390.          ENDIF  
  391.       ENDIF 
  392. C End special treatment for ICL2 GOTO   
  393.       IF(LCHECK(22).AND.(LPRINT(ICL1).OR.LPRINT(ICL2))) THEN
  394. C PRINT statement   
  395.          IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB,SIMA(II),II=NST,  
  396.      +   NFI)   
  397.          WRITE(MZUNIT,770)  
  398.          NFAULT = NFAULT + 1
  399.       ELSE IF(LCHECK(23).AND.ICL1.EQ.IEND) THEN 
  400. C END statement 
  401.          IF(SIMA(NST)(:5).NE.'     ') THEN  
  402.             IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB,SIMA(II),II
  403.      +      =NST, NFI)  
  404.             WRITE(MZUNIT,790)   
  405.             NFAULT = NFAULT + 1 
  406.          ENDIF  
  407.       ELSE IF(LWRITE(ICL1).OR.LWRITE(ICL2)) THEN
  408. C WRITE statement   
  409.          IF(LCHECK(24)) THEN
  410.             ILOC = INDEX(SSTA(:NCHST),'WRITE')+5
  411.             ILOC1 = INDEX(SSTA(ILOC:NCHST),'(') 
  412.             IF(ILOC1.EQ.0.OR.ILOC.EQ.0)                         GOTO 240
  413.             ILOC = ILOC1 + ILOC 
  414.             DO 230 IL=ILOC,MXLINE   
  415.                IF(SSTA(IL:IL).EQ.' ')                           GOTO 230
  416.                IF(SSTA(IL:IL).EQ.'*') THEN  
  417.                   IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB,SIMA(II),
  418.      +            II =NST,NFI)  
  419.                   WRITE(MZUNIT,800) 
  420.                   NFAULT = NFAULT + 1   
  421.                ELSE 
  422.                                                                 GOTO 240
  423.                ENDIF
  424.   230       CONTINUE
  425.   240       CONTINUE
  426.          ENDIF  
  427.       ENDIF 
  428.       IF(LCHECK(26).AND.(LPAUSE(ICL1).OR.LPAUSE(ICL2))) THEN
  429. C PAUSE statement   
  430.          IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB,SIMA(II),II=NST,  
  431.      +   NFI)   
  432.          WRITE(MZUNIT,810)  
  433.          NFAULT = NFAULT + 1
  434.       ENDIF 
  435. C check for statement labels beginning in column 1  
  436.       IF(LCHECK(27)) THEN   
  437.          IF(LLE(SIMA(NST)(1:1),'9').AND.LGE(SIMA(NST)(1:1),'0')) THEN   
  438.             IF(.NOT.USFULL)WRITE(MZUNIT,850)(II+ISGLOB,SIMA(II),II=NST, 
  439.      +      NFI)
  440.             WRITE(MZUNIT,530)   
  441.             NFAULT = NFAULT + 1 
  442.          ENDIF  
  443.       ENDIF 
  444.       IF(LCHECK(28).AND.(LSTOP(ICL1).OR.LSTOP(ICL2))) THEN  
  445. C STOP statement
  446.          IF(.NOT.LWRITE(ICLOLD)) THEN   
  447.             IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB,SIMA(II),II
  448.      +      =NST, NFI)  
  449.             WRITE(MZUNIT,820)   
  450.             NFAULT = NFAULT + 1 
  451.          ENDIF  
  452.       ENDIF 
  453. C Check for ENTRY in FUNCTION   
  454.       IF(LCHECK(29).AND.LENTRY(ICL1).AND.IFUNC.EQ.1) THEN   
  455.          IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB,SIMA(II),II=NST,  
  456.      +   NFI)   
  457.          WRITE(MZUNIT,830)  
  458.          NFAULT = NFAULT + 1
  459.       ENDIF 
  460. C Check for I/O in FUNCTION 
  461.       IF(LCHECK(30).AND.IFUNC.EQ.1) THEN
  462.          IF(LIO(ICL1)) THEN 
  463.             IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB,SIMA(II),II
  464.      +      =NST,NFI)   
  465.             WRITE(MZUNIT,780)   
  466.             NFAULT = NFAULT + 1 
  467.          ENDIF  
  468.          IF(LIO(ICL2)) THEN 
  469.             IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB,SIMA(II),II
  470.      +      =NST,NFI)   
  471.             WRITE(MZUNIT,780)   
  472.             NFAULT = NFAULT + 1 
  473.          ENDIF  
  474.       ENDIF 
  475. C check for alternate RETURN
  476.       IF(LCHECK(31).AND.(LRETRN(ICL1).OR.LRETRN(ICL2))) THEN
  477.          IPOSR=INDEX(SSTA(:NCHST),'RETURN') 
  478.          IF(IPOSR.NE.0.AND.IPOSR+5.NE.NCHST) THEN   
  479.             IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB, SIMA(II),II   
  480.      +      =NST, NFI)  
  481.             WRITE(MZUNIT,540)   
  482.             NFAULT = NFAULT + 1 
  483.          ENDIF  
  484.       ENDIF 
  485. C Check for COMMON block title clash with variable name 
  486.       IF(.NOT.LCOMMN(ICL1).AND..NOT.LSAVE(ICL1)) THEN   
  487.          DO 280 IS=1,NSNAME 
  488.             ILEN = INDEX(SNAMES(IS+ISNAME),' ')-1   
  489.             DO 250 ICT=1,NCOMT  
  490.                ILEN2 = INDEX(SCTITL(ICT),' ')-1 
  491.                IF(ILEN2.NE.ILEN)                                GOTO 250
  492.                IF(LCHECK(32)) THEN  
  493.                   IF(SNAMES(IS+ISNAME).EQ.SCTITL(ICT)) THEN 
  494.                      IF(.NOT.USFULL) WRITE(MZUNIT,850) (II+ISGLOB,SIMA  
  495.      +               (II),II =NST,NFI)  
  496.                      WRITE(MZUNIT,840) SCTITL(ICT),SCTITL(ICT)  
  497.                      NFAULT = NFAULT + 1
  498.                                                                 GOTO 260
  499.                   ENDIF 
  500.                ENDIF
  501.   250       CONTINUE
  502.   260       CONTINUE
  503. C Mark COMMON block variables as used   
  504.             DO 270 ICN=1,NCOMN  
  505.                ILEN2 = INDEX(SCNAME(ICN),' ')-1 
  506.                IF(ILEN2.NE.ILEN)                                GOTO 270
  507.                IF(SCNAME(ICN).EQ.SNAMES(IS+ISNAME)) THEN
  508.                   ICM = ICNAME(ICN) 
  509.                   ICTITL(ICM) = -IABS(ICTITL(ICM))  
  510.                ENDIF
  511.   270       CONTINUE
  512.   280    CONTINUE   
  513.       ENDIF 
  514. C Make ICLOLD last executable statement 
  515.       IF(ISTMDS(11,ICL1).EQ.1) THEN 
  516.          ICLOLD = ICL2  
  517.          IF(ICL1.NE.IIF) ICLOLD = ICL1  
  518.       ENDIF 
  519. C   
  520.   500 FORMAT(/,1X,'!!! WARNING ... INPUT FORTRAN SHOULD BEGIN', 
  521.      +' WITH MODULE DECLARATION EG "PROGRAM  ... "')
  522.   510 FORMAT((1X,I6,'. ',A80))  
  523.   520 FORMAT(1X,'!!! WARNING ... USE STANDARD FORTRAN TYPES')   
  524.   530 FORMAT(1X,'!!! STATEMENT HAS LABEL BEGINNING IN COLUMN 1')
  525.   540 FORMAT(1X,'!!! STATEMENT USES THE ALTERNATE RETURN FACILITY') 
  526.   550 FORMAT(/,1X,20('+'), ' BEGIN MODULE CHECKS          ',10('+'), /, 
  527.      +21X,' FOR ',A80,(/,1X,A80))   
  528.   560 FORMAT(1X,'!!! WARNING ... AVOID COMMENT LINES',  
  529.      +' BEFORE MODULE DECLARATION') 
  530.   570 FORMAT(1X,'!!! WARNING ... MODULE ',A,
  531.      +' CLASHES WITH INTRINSIC FUNCTION ',A)
  532.   580 FORMAT(1X,'!!! WARNING ... NOT ENOUGH (<3) COMMENT',  
  533.      +' LINES AT START OF MODULE')  
  534.   590 FORMAT(1X,'!!! COMMENT DOES NOT START WITH "C"')  
  535.   600 FORMAT(1X,'    IT SHOULD BE A HISTORIAN "CALL" ANYWAY')   
  536.   610 FORMAT(1X,'!!! STATEMENT HAS COMMENT PLACED BEFORE CONTINUATION') 
  537.   620 FORMAT(1X,'!!! STATEMENT CONTAINS >1 COMMON DEFINITION')  
  538.   630 FORMAT(1X,'!!! NON-FATAL ERROR IN USSBEG . MCOMT EXCEEDED')   
  539.   640 FORMAT(1X,'!!! NON-FATAL ERROR IN USSBEG . MCOMN EXCEEDED')   
  540.   650 FORMAT(1X,'!!! STATEMENT DIMENSIONS ',A,' OUTSIDE COMMON')
  541.   660 FORMAT(1X,'!!! NAME ',A,' HAS EMBEDDED BLANKS AT SOURCE') 
  542.   670 FORMAT(1X,'!!! THE KEYWORD ',A,' CONTAINS BLANKS')
  543.   680 FORMAT(1X,'!!! STATEMENT HAS NO BLANK AFTER KEYWORD ',A25)
  544.   690 FORMAT(1X,'!!! KEYWORD "ELSE IF" CONTAINS MISPLACED BLANKS')  
  545.   700 FORMAT(1X,'!!! STATEMENT HAS NO BLANK AFTER "ELSEIF"')
  546.   710 FORMAT(1X,'!!! KEYWORD "GO TO" CONTAINS MISPLACED BLANKS')
  547.   720 FORMAT(1X,'!!! STATEMENT HAS NO BLANK AFTER "GO TO"') 
  548.   730 FORMAT(1X,'!!! STATEMENT HAS NO BLANK AFTER "GOTO"')  
  549.   740 FORMAT(1X,'!!! STATEMENT HAS NO BLANK AFTER "GOTO"')  
  550.   750 FORMAT(1X,'!!! STATEMENT HAS NO BLANK AFTER "GO TO"') 
  551.   760 FORMAT(1X,'!!! STATEMENT CONTAINS EMBEDDED BLANKS IN "GO TO"')
  552.   770 FORMAT(1X,'!!! STATEMENT SHOULD BE A WRITE STATEMENT')
  553.   780 FORMAT(1X,'!!! I/O IN FUNCTIONS DISALLOWED')  
  554.   790 FORMAT(1X,'!!! STATEMENT SHOULD NOT HAVE LABEL')  
  555.   800 FORMAT(1X,'!!! STATEMENT SHOULD NOT HAVE LUN=*')  
  556.   810 FORMAT(1X,'!!! PAUSE STATEMENTS ARE FROWNED UPON')
  557.   820 FORMAT(1X,'!!! STATEMENT SHOULD BE PRECEDED BY A "WRITE"')
  558.   830 FORMAT(1X,'!!! ENTRY STATEMENTS DISALLOWED IN FUNCTION')  
  559.   840 FORMAT(1X,'!!! ',A,' CLASHES WITH COMMON BLOCK NAME ',A)  
  560.   850 FORMAT(/,(1X,I6,'. ',A80))
  561.       END   
  562.